Collection of Tools & Utilities/Collection of Tools and Utilities.iso/tex/mfrm240.zip/MM.BAS

BASIC Source File | 1991-05-02 | 12.1 KB | 383 lines

' Source code for Mainframe Mania - version 2.4 May 1, 1991

DEFINT A-Z
DIM BEG.COL(200),LEN.FIELD(200),NUM.DECIMALS(200),NEG.COUNT(200)
DIM WRDS$(10),LastIn$(200),LastOut$(200)              '2.4

'          -------------[ Subprograms ]--------------
SUB TRAILSIGN (FIELD.TO.EDIT$,TRAIL.SIGN) STATIC

TRAIL.SIGN = 0
TRAILING.SIGN$ = RIGHT$(FIELD.TO.EDIT$,1)
K = INSTR(" +-",TRAILING.SIGN$)                        '092987
IF K < 1 THEN EXIT SUB
X$ = "X" + FIELD.TO.EDIT$
L = LEN(FIELD.TO.EDIT$)
J = L
WHILE INSTR("0123456789",MID$(X$,J,1)) <> 0
   J = J - 1
WEND
IF J = L THEN EXIT SUB
TRAIL.SIGN = -1
MID$(FIELD.TO.EDIT$,J+1) = MID$(FIELD.TO.EDIT$,J)
MID$(FIELD.TO.EDIT$,J,1) = MID$("  -",K,1)             '092987

END SUB

SUB OVERSTRIKE (FLD$,SIGN.OF.NUM,WHETHER.CONVERTED) STATIC
' locate 20,1:print "overstrike got: ";fld$
WHETHER.CONVERTED = 0
SIGN.OF.NUM = 1
LAST.CHAR$ = RIGHT$(FLD$,1)
IF INSTR("0123456789",LAST.CHAR$) > 0 THEN _
   EXIT SUB
WHETHER.CONVERTED = -1
X = INSTR("{ABCDEFGHI}JKLMNOPQR:",LAST.CHAR$) + 1
IF X > 11 THEN SIGN.OF.NUM = -1
LAST.CHAR$ = MID$("0012345678901234567890",X,1)
MID$(FLD$,LEN(FLD$),1) = LAST.CHAR$
END SUB

SUB FIRSTNB (STRNG$,BEG%,WHEREIS%) STATIC

REM PASS STRNG$  - A STRING TO BE SEARCHED
REM      BEG%     - POSITION TO BEGIN SEARCH
REM GET  WHEREIS% - POSITION IN STRNG$ OF FIRST NON-BLANK AT
REM                  BEG% OR LATER.  RETURNS 0 IF NO NON-BLANK.

REM LOCATE 24,70:PRINT "FIRSTNB  ";
X$ = STRNG$+"!"
WHEREIS% = BEG%
IF WHEREIS% < 1 THEN WHEREIS% = 1
WHILE MID$(X$,WHEREIS%,1) = " "
   WHEREIS% = WHEREIS% + 1
WEND
IF WHEREIS% > LEN(STRNG$) THEN WHEREIS% = 0

END SUB

SUB LASTNB (STRNG$,BEG%,WHEREIS%) STATIC

REM PASS STRNG$   - A STRING TO BE SEARCHED
REM      BEG%      - POSITION TO BEGIN SEARCH
REM GET  WHEREIS%  - LAST POSITION IN STRNG$ OF ANY WORD BEGINNING AT
REM                   BEG% OR LATER.  RETURNS BEG%-1 IF NO WORD AT BEG%.

REM LOCATE 24,70:PRINT "LASTNB  ";
B = BEG
IF B < 1 THEN B = 1
IF B > LEN(STRNG$) THEN_
   X$ = " " _
ELSE_
   X$ = MID$(STRNG$,B)+" "
WHEREIS% = INSTR(X$," ") - 1 + B - 1

END SUB

SUB BRKWORDS (STRNG$,WORDS$(1)) STATIC

REM PASS STRNG$  - A STRING TO BE BROKEN INTO WORDS (SPACE
REM                 DELIMITED STRINGS)
REM      WORDS$  - AN ARRAY TO PUT WORDS IN

ONE = 1
LST = LEN(STRNG$)
X$ = STRNG$ + " !"
CALL FIRSTNB(X$,ONE,BS)
NPARMS = 0
MAXPARMS = 10 ' UBOUND(WORDS$)
WHILE BS <= LST
  NPARMS = NPARMS + 1
  CALL LASTNB (X$,BS,ES)
  IF NPARMS > MAXPARMS THEN _
     BS = LST+1_
  ELSE_
     WORDS$(NPARMS) = MID$(X$,BS,ES-BS+1):_
     BS = ES+1:_
     CALL FIRSTNB(X$,BS,BS)
WEND
'for i=1 to nparms:print "<";words$(i);">":next
I = 1
WHILE I <= NPARMS
   IF INSTR(WORDS$(I),"/") > 0 THEN _
     FOR J = I TO NPARMS-1 : _
        WORDS$(J) = WORDS$(J+1): _
     NEXT : _
     WORDS$(NPARMS) = "" : _
     NPARMS = NPARMS - 1 _
   ELSE _
     I = I + 1
WEND
'print "/: ";:for i=1 to nparms: print "<";words$(i);">":next
'INPUT XX$
END SUB

SUB TRIMLEFT (STRNG$) STATIC

WHILE LEFT$(STRNG$,1)=" "
   STRNG$=MID$(STRNG$,2)
WEND

END SUB

SUB CONVSCI (STRNG$) STATIC

J = INSTR(STRNG$,"E")
IF J < 1 THEN EXIT SUB
IF J = LEN(STRNG$) THEN EXIT SUB
Y$ = LEFT$(STRNG$,J-1)
MOVE.DEC = VAL(MID$(STRNG$,J+1))
IF MOVE.DEC = 0 THEN STRNG$ = Y$ : EXIT SUB

CALL TRIMLEFT (Y$)
IF LEFT$(Y$,1) = "-" THEN
   SIGN.FIELD$ = "-"
   Y$ = MID$(Y$,2)
ELSE
   SIGN.FIELD$ = ""
END IF
K = INSTR(Y$,".")
IF K = 0 THEN K = LEN(Y$)+1 : Y$ = Y$+"."
CHAR.RIGHT = LEN(Y$) - K
CHAR.RIGHT$ = RIGHT$(Y$,CHAR.RIGHT)
CHAR.LEFT = LEN(Y$) - 1 - CHAR.RIGHT
CHAR.LEFT$ = LEFT$(Y$,CHAR.LEFT)
' PRINT "<";CHAR.LEFT$;"-";CHAR.RIGHT$;">"
' input xxx$
IF MOVE.DEC > 0 THEN
   IF CHAR.RIGHT < MOVE.DEC THEN
      CHAR.RIGHT$ = CHAR.RIGHT$ + STRING$(MOVE.DEC-CHAR.RIGHT,"0")
   END IF
   CHAR.RIGHT$ = LEFT$(CHAR.RIGHT$,MOVE.DEC) + "." + RIGHT$(CHAR.RIGHT$,LEN(CHAR.RIGHT$)-MOVE.DEC)
ELSE
   IF CHAR.LEFT < -MOVE.DEC THEN
      CHAR.LEFT$ = STRING$(-MOVE.DEC-CHAR.LEFT,"0") + CHAR.LEFT$
   END IF
   CHAR.LEFT$ = LEFT$(CHAR.LEFT$,LEN(CHAR.LEFT$)+MOVE.DEC) + "." + RIGHT$(CHAR.LEFT$,-MOVE.DEC)
END IF
' LOCATE 17,1:PRINT "<";STRNG$;"> converted to <";sign.field$;char.left$;char.right$;">   ";
' input xxx$
STRNG$ = SIGN.FIELD$ + CHAR.LEFT$ + CHAR.RIGHT$
K = INSTR(STRNG$,".")                             ' 2.3
I = LEN(STRNG$)                                   ' 2.3
WHILE I > K AND RIGHT$(STRNG$,1) = "0"            ' 2.3
   I = I - 1                                      ' 2.3
   STRNG$ = LEFT$(STRNG$,I)                       ' 2.3
WEND                                              ' 2.3
END SUB

'    ---------------[  main program   ]---------------
ON ERROR GOTO 1010
X$ = COMMAND$
I = (INSTR(X$,"/B") > 0)
J = (INSTR(X$,"/b") > 0)
RUN.BATCH = (I OR J)
I = (INSTR(X$,"/T") > 0)
J = (INSTR(X$,"/t") > 0)
SINGLE.STEP = (I OR J) AND NOT RUN.BATCH
' SINGLE.STEP = -1
CALL BRKWORDS (X$,WRDS$())

IF WRDS$(1) <> "" THEN _
  FILE.TO.EDIT$ = WRDS$(1)_
ELSE_
  FILE.TO.EDIT$ = "MM.ZON"
IF WRDS$(2) <> "" THEN_
  FILE.TO.OUTPUT$ = WRDS$(2)_
ELSE_
  FILE.TO.OUTPUT$ = "MM.DMZ"
IF WRDS$(3) <> "" THEN_
  FILE.OF.CONV$ = WRDS$(3)_
ELSE_
  FILE.OF.CONV$ = "CONV.TBL"

100 CLS
LOCATE 1,2
PRINT "Mainframe Mania 2.4 (05-01-91) QB - A Conversion Utility for Mainframe Data" '2.2
LOCATE 2,22                                       ' 2.2
PRINT "(c) 1987-91 by Ken Goosens"              ' 2.4
LOCATE 4,10
PRINT "Format:  MM[/B/T]  <source data>  <output file>  <how convert>"
LOCATE 6,6
PRINT "File to convert: ";FILE.TO.EDIT$
LOCATE 6,43
PRINT "Output to: ";FILE.TO.OUTPUT$
LOCATE 8,20
PRINT "Using conversion table: ";FILE.OF.CONV$

LOCATE 18,20
IF NOT RUN.BATCH THEN INPUT "<C>ancel or <R>un? [ENTER = R] ",ANS$
IF ANS$ <> "" THEN _
  IF INSTR("Rr",LEFT$(ANS$,1)) < 1 THEN END
ST# = TIMER
LOCATE 18,1:PRINT SPACE$(79);

ON ERROR GOTO 900
OPEN FILE.OF.CONV$ FOR INPUT AS #1
ON ERROR GOTO 950
INPUT #1,DATA.LEN,REC.DELIMITOR$
' print "data len=";data.len;" len delimiter=";len(rec.delimitor$)
LEN.REC.DELIMITOR = LEN(REC.DELIMITOR$)            ' 2.3
REC.LEN = DATA.LEN + LEN.REC.DELIMITOR             ' 2.3
FIELDS.TO.CONVERT = 0
WHILE NOT EOF(1)
   FIELDS.TO.CONVERT = FIELDS.TO.CONVERT + 1
   INPUT #1,BEG.COL(FIELDS.TO.CONVERT),_
            LEN.FIELD(FIELDS.TO.CONVERT),_
            NUM.DECIMALS(FIELDS.TO.CONVERT)
WEND
' for i=1 to fields.to.convert:print beg.col(i),len.field(i),num.decimals(i):next
CLOSE 1

ON ERROR GOTO 1000
OPEN FILE.TO.EDIT$ FOR INPUT AS #1
ON ERROR GOTO 1010
CLOSE 1
OPEN "R",1,FILE.TO.EDIT$,REC.LEN
NUM.RECS# = LOF(1)
NUM.RECS = INT(NUM.RECS#/REC.LEN)
FIELD 1, DATA.LEN AS A$, _                      ' 2.3
         LEN.REC.DELIMITOR AS A.DELIMITOR$      ' 2.3
IF FILE.TO.OUTPUT$ = FILE.TO.EDIT$ THEN _
   FILE.TO.OUTPUT$ = "MM.($)"
OPEN FILE.TO.OUTPUT$ FOR OUTPUT AS #2
LINE.READ = 0
LOCATE 11,20
PRINT "# records to process:";NUM.RECS;
LOCATE 14,20
PRINT "Processing record #";
IF SINGLE.STEP THEN _
   LOCATE 15,20 : _
   PRINT "Processing field: "; : _
   LOCATE 16,20 : _
   PRINT "    Converted to: ";
FOR LINES.READ = 1 TO NUM.RECS
   GET 1,LINES.READ
   IF A.DELIMITOR$ <> REC.DELIMITOR$ THEN     ' 2.3
      IF LINES.READ < NUM.RECS THEN           ' 2.3
         LOCATE 15,10                                         ' 2.3
         PRINT "Improper record delimitor encountered on record";LINES.READ;  '2.3
         LOCATE 16,10                                         ' 2.3
         PRINT "Aborting.  Bad record is";                    ' 2.3
         LOCATE 17,1                                          ' 2.3
         PRINT A$                                             ' 2.3
         END                                                  ' 2.3
      END IF                                                  ' 2.3
   END IF                                                     ' 2.3
   LOCATE 14,40
   PRINT LINES.READ;
   NEXT.COL = 1
   FOR I = 1 TO FIELDS.TO.CONVERT
      IF NEXT.COL < BEG.COL(I) THEN _
         PRINT #2,MID$(A$,NEXT.COL,BEG.COL(I)-NEXT.COL);
      NEXT.COL = BEG.COL(I) + LEN.FIELD(I)
      FIELD.TO.EDIT$ = MID$(A$,BEG.COL(I),LEN.FIELD(I))
      FIELD.SAVE$ = FIELD.TO.EDIT$
      IF SINGLE.STEP THEN                              '2.2
         LOCATE 15,38                                   '2.2
         LFS = LEN(FIELD.SAVE$)                         '2.2
         NSPACES = (LFS - PLFS)*(LFS < PLFS)            '2.2
         PRINT FIELD.SAVE$;SPACE$(NSPACES)              '2.2
      END IF
      IF FIELD.SAVE$ = LastIn$(I) THEN                  '2.4
         X$ = LastOut$(I)                               '2.4
         GOTO GotConversion                             '2.4
      END IF                                            '2.4
      PLFS = LEN(FIELD.SAVE$)
      CALL TRAILSIGN (FIELD.TO.EDIT$,TRAIL.SIGN)
      CALL OVERSTRIKE (FIELD.TO.EDIT$,LEAD.SIGN,WHETHER.CONVERTED)
      IF WHETHER.CONVERTED OR TRAIL.SIGN THEN
         NEG.COUNT(I) = NEG.COUNT(I) + 1
'      print i;" ";field.to.edit$;" lftoed=";len(field.to.edit$);" ";NUM.DECIMALS(i) : input xx$
      END IF
      FIELD.TO.EDIT$ = LEFT$(FIELD.TO.EDIT$,LEN(FIELD.TO.EDIT$)-_
                          NUM.DECIMALS(I))+"."+_
                          RIGHT$(FIELD.TO.EDIT$,NUM.DECIMALS(I))
      X$ = STR$(LEAD.SIGN * VAL(FIELD.TO.EDIT$))
      CALL CONVSCI (X$)                                   ' 2.1
      CALL TRIMLEFT (X$)                                  ' 2.2
      IF LEN(X$) > LEN.FIELD(I)+2 THEN                    ' 2.2
            X$ = LEFT$(X$,LEN.FIELD(I)+2)                 ' 2.2
      END IF                                              ' 2.1
      X$ = SPACE$(LEN.FIELD(I) + 2 - LEN(X$)) + X$
      LastIn$(I) = FIELD.SAVE$                            ' 2.4
      LastOut$(I) = X$                                    ' 2.4
GotConversion:                                            ' 2.4
      PRINT #2,X$;
      IF SINGLE.STEP THEN _
         LOCATE 16,38 : _
         PRINT X$;"   "; : _                              ' 2.2
         LOCATE 17,18 : _
         INPUT " A)bort, N)on-stop, [ENTER] to continue ",ANS$ : _
         IF ANS$ <> "" THEN _
            ANS$ = LEFT$(ANS$,1) : _
            J = INSTR ("AaNn",ANS$) : _
            IF J > 0 THEN _
               LOCATE 15,20 : _
               PRINT SPACE$(58); : _
               LOCATE 16,20 : _
               PRINT SPACE$(58); : _
               LOCATE 17,18 : _
               PRINT SPACE$(60); : _
               IF J < 3 THEN _
                  END _
               ELSE _
                  SINGLE.STEP = 0
'       print "<";FIELD.SAVE$;"> converted to <";X$;">"
   NEXT
   IF NEXT.COL <= LEN(A$) THEN _
      PRINT #2,MID$(A$,NEXT.COL)_
   ELSE_
      PRINT #2,
' print "lines.read = ";lines.read;" num.recs ";num.recs
NEXT
CLOSE
IF FILE.TO.OUTPUT$ = "MM.($)" THEN _
   KILL FILE.TO.EDIT$ : _
   X$ = ":" + FILE.TO.EDIT$ : _
   J = LEN(X$) : _
   WHILE INSTR(":\",MID$(X$,J,1)) = 0 : _
      J = J-1 : _
   WEND : _
   NAME FILE.TO.OUTPUT$ AS MID$(FILE.TO.EDIT$,J)
LOCATE 16,1
PRINT TAB(24);"Conversion Report"
TOT.CT = 0
FOR I = 1 TO FIELDS.TO.CONVERT
   TOT.CT = TOT.CT + NEG.COUNT(I)
   IF NEG.COUNT(I) > 0 THEN PRINT " FIELD ";I; " converted ";NEG.COUNT(I);
NEXT
IF TOT.CT = 0 THEN _
   PRINT TAB(22);"- no fields changed -"
PRINT
FIN# = TIMER
PRINT TAB(15);"Processing time:";FIN#-ST#;" seconds"
END

 900 CLS
     LOCATE 10,10
     PRINT "Unable to find conversion table ";FILE.OF.CONV$
     LOCATE 12,10
     INPUT "Enter correct name ([ENTER] aborts) ",FILE.OF.CONV$
     IF FILE.TO.EDIT$ = "" THEN _
        LOCATE 14,10 : _
        PRINT "Please create one with an editor.": _
        END
     RESUME 100
 950 CLS
     LOCATE 10,10
     PRINT "Conversion table ";FILE.OF.CONV$;" not in proper format."
     LOCATE 12,10
     PRINT "Error ";ERR;".  Aborting."
     END
1000 CLS
     LOCATE 10,10
     PRINT "Unable to find data file ";FILE.TO.EDIT$;"  Error ";ERR
     LOCATE 12,10
     INPUT "Enter correct name ([ENTER] aborts) ",FILE.TO.EDIT$
     IF FILE.TO.EDIT$ = "" THEN END
     RESUME 100
1010 LOCATE 18,10
     PRINT "Untrapped error ";ERR;".  Aborting."
     END